;; Tests of the optimal bitonic tour functions
;; Copyright (C) 2022  Rocks Mazama
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(ns mazama.compgeom.optimal-bitonic-tour-test
  (:require
   [clojure.test :refer [deftest is testing]]
   [mazama.compgeom.optimal-bitonic-tour :refer [optimal-bitonic-tour]]))

(def EPSILON 1/1000000)
 
;;; Reference: https://floating-point-gui.de/errors/comparison/
(defn nearly==
  ""
  ([a b] (nearly== a b EPSILON))
  ([a b epsilon]
   (or (== a b)
       (if (and (rational? a) (rational? b))
         false
         (let [absA (abs a)
               absB (abs b)
               diff (abs (- a b))]
           (if (or (== a 0) (== b 0) (< (+ absA absB) Float/MIN_NORMAL))
             (< diff (* epsilon Float/MIN_NORMAL))
             (< (/ diff (min (+ absA absB) Float/MAX_VALUE)) epsilon)))))))

(defn- dist [[p1 p2] [q1 q2]]
  (let [dx (- q1 p1)
        dy (- q2 p2)]
    (Math/sqrt (+ (* dx dx) (* dy dy)))))

(defn- bitonic-length [[u v]]
  (let [S (concat u v)]
    (if (< (count S) 2)
      0
      (letfn [(f [v [p q]]
              (+ v (dist p q)))]
        (+ (reduce f 0 (map vector S (rest S)))
           (dist (first u) (last v)))))))

(defn- monotonic? [f xs]
  (or (empty? xs) (apply f xs)))

(defn- bitonic? [[u v]]
  (and (monotonic? <= (map first u))
       (monotonic? >= (map first v))))

(defn- check-bitonic [coll cost]
  (let [[u v :as tour] (optimal-bitonic-tour coll)]
    (is (= (sort coll) (sort (concat u v))))
    (is (bitonic? tour))
    (is (nearly== cost (bitonic-length tour)))))

(deftest small-test
  (testing "nil"
    (let [coll nil]
      (check-bitonic coll 0)))
  (testing "zero"
    (let [coll ()]
      (check-bitonic coll 0)))
  (testing "one"
    (let [coll [[2 -37]]]
      (check-bitonic coll 0)))
  (testing "two"
    (let [coll [[-3 7] [-6 3]]]
      (check-bitonic coll 10))))

(deftest unusual-test
  (testing "horizontal"
    (let [coll (map #(vector % 37) (range 4))]
      (check-bitonic coll 6)))
  (testing "vertical"
    (let [coll (map (partial vector -1) (range 0 8 2))]
      (check-bitonic coll 12)))
  (testing "rectangle"
    (let [coll [[0 0] [0 3] [4 0] [4 3]]]
      (check-bitonic coll 14)))
  (testing "grid"
    (let [coll (for [y (range 0 16 4) x (range 0 12 3)] [x y])]
      (check-bitonic coll (+ (* 2 3) (* 10 4) (* 4 5)))))
  (testing "duplicate points"
    (let [coll [[9 4] [9 4] [6 8] [6 8] [3 4] [3 4] [0 0] [0 0] [12 0] [12 0]]]
      (check-bitonic coll 32))))

(deftest Oege-de-Moor-test
  (testing "Pages 12-13 in https://www.google.com/books/edition/Programming_Languages_Implementations_Lo/RDcOfSoCg_4C"
    (let [coll [[5 4] [6 1] [8 2] [7 5] [0 6] [1 0] [2 3]]]
      (check-bitonic coll 25.58402459469133))))

(deftest other-test
  (testing "trough"
    (let [coll [[9 4] [6 8] [3 4] [0 0] [12 0]]]
      (check-bitonic coll 32)))
  (testing "flat-trough"
    (let [coll [[9 4] [6 4] [3 4] [0 0] [12 0]]]
      (check-bitonic coll 28)))
  (testing "double-trough"
    (let [coll [[9 4] [6 0] [3 4] [0 0] [12 0]]]
      (check-bitonic coll 28))))
